C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  ISTLX  - FORTRAN 77 SCANNER
C           TABLES MECHANICALLY GENERATED BY FSCAN
C
C  VERSION 2: This version uses the revised token/comment stream
C             formats and the general purpose interface to the
C             scanner routine ZSCAN. Note that there is no longer
C             an error file and that the list file is optional
C             (a file name of '-' will prevent the list file being
C             produced).
C
      PROGRAM ISTLX
 
      INTEGER SRC, TKN, LST, CMT, STATUS, MULTI
      INTEGER SRCPTH(81), LSTPTH(81)
      INTEGER OPEN, CREATE, GETARG
 
      COMMON /NAMES/  TKNPTH, CMTPTH, TPT1, TPT2, TPT3, CPT1, CPT2, CPT3
      INTEGER         TKNPTH(81),CMTPTH(81)
      INTEGER         TPT1, TPT2, CPT1, CPT2, TPT3, CPT3
 
      SAVE
 
C INITIALISE TIE
      CALL ZINIT
 
C CHECK FOR THE EXISTENCE OF THE REQUIRED PATHNAMES
      IF(GETARG(1, SRCPTH, 81) .EQ. -100) CALL FNAMES(1, SRCPTH)
      IF(GETARG(2, LSTPTH, 81) .EQ. -100) CALL FNAMES(2, LSTPTH)
      IF(GETARG(3, TKNPTH, 81) .EQ. -100) CALL FNAMES(3, TKNPTH)
      IF(GETARG(4, CMTPTH, 81) .EQ. -100) CALL FNAMES(4, CMTPTH)
 
C FIND OUT IF FILE SPLITTING IS REQUESTED
      CALL CHKNAM(MULTI)
 
C OPEN OR CREATE ALL FILES
      SRC = OPEN (SRCPTH, 0)
      IF (SRC .EQ. -1) CALL ERROR
     +  ('ISTLX - UNABLE TO OPEN SOURCE FILE.')
      TKN = CREATE (TKNPTH, 1)
      IF (TKN .EQ. -1) CALL ERROR
     +  ('ISTLX - UNABLE TO CREATE TOKEN FILE.')
      CMT = CREATE (CMTPTH, 1)
      IF (CMT .EQ. -1) CALL ERROR
     +  ('ISTLX - UNABLE TO CREATE COMMENT FILE.')
 
      IF(LSTPTH(1) .NE. 45) THEN
        LST = CREATE (LSTPTH, 1)
        IF (LST .EQ. -1) CALL ERROR
     +    ('ISTLX - UNABLE TO CREATE LIST FILE.')
      ELSE
        LST = -1
      ENDIF
 
C  CALL THE SCANNING ROUTINE
      CALL NEWLX (SRC, LST, TKN, CMT, STATUS, MULTI)
 
C  REPORT THE NUMBER OF FILES CREATED (IF MULTIPLE FILES REQUIRED)
      IF(MULTI .GT. 0) THEN
        CALL ZCHOUT('[ISTLX: .', 1)
        CALL ZPTINT(MULTI, 1, 1)
        CALL ZMESS(' Files Created].', 1)
      ENDIF
 
C  CHECK IF ANY ERRORS WERE REPORTED AND TERMINATE THE TOOL
      IF(STATUS .EQ. -2) THEN
         CALL ZMESS('[ISTLX Normal Termination].', 1)
         CALL ZQUIT(-2)
      ELSE IF(STATUS .EQ. -1002) THEN
         CALL ZMESS('[ISTLX Warnings Reported].', 1)
         CALL ZQUIT(-1002)
      ELSE
         CALL ZMESS('[ISTLX Errors Reported].', 1)
         CALL ZQUIT(-1)
      ENDIF
 
      END
C-------------------------------------------------
C
C  PROMPT FOR MISSING FILE NAMES
C
      SUBROUTINE FNAMES(OPT, PATH)
 
      INTEGER PATH(*), MSGS(15, 4)
      INTEGER ZGTCMD
      INTEGER STAT, OPT, I
 
      DATA (MSGS(I, 1),I=1,15)/83,111,117,114,99,101,32,
     +                    32, 102,105,108,101,58,32,129/
      DATA (MSGS(I, 2),I=1,15)/76,105,115,116,32,32,32,
     +                    32, 102,105,108,101,58,32,129/
      DATA (MSGS(I, 3),I=1,15)/84,111,107,101,110,32,32,
     +                    32, 102,105,108,101,58,32,129/
      DATA (MSGS(I, 4),I=1,15)/67,111,109,109,101,110,116,
     +                    32, 102,105,108,101,58,32,129/
 
      IF(OPT .LE. 0  .OR.  OPT .GT. 4) RETURN
      CALL ZPRMPT(MSGS(1, OPT))
      STAT = ZGTCMD(PATH, 0)
 
      END
C-------------------------------------------------
C
C  CHECK TO SEE IF MULTIPLE OUTPUT FILES ARE REQUESTED
C
      SUBROUTINE CHKNAM(MULTI)
 
      COMMON /NAMES/  TKNPTH, CMTPTH, TPT1, TPT2, TPT3, CPT1, CPT2, CPT3
      INTEGER         TKNPTH(81), CMTPTH(81),
     +                 TPT1, TPT2, CPT1, CPT2, TPT3, CPT3
      INTEGER MULTI
      INTEGER TEMP(81), POINTT, POINTC, LENGTH, I
C*********************************************************************
C  INSTALLER: THE FOLLOWING PARAMETERS CONTROL WHICH CHARACTERS IN A
C             HOST FILENAME ARE CHANGED WHEN MULTIPLE OUTPUT FILES
C             ARE REQUESTED. AS CURRENTLY SET, THE SECOND, THIRD AND
C             FOURTH CHARACTERS WILL BE MODIFIED, E.G."FRED.TKN" WOULD
C             BECOME "FAAA.TKN", "FAAB.TKN" ETC.
C
      INTEGER HOST1, HOST2, HOST3
      PARAMETER (HOST1=2, HOST2=3, HOST3=4)
C*********************************************************************
      SAVE
 
      IF(TKNPTH(1) .NE. 40) THEN
        IF(CMTPTH(1) .EQ. 40)
     +    CALL ERROR('[ISTLX - INVALID COMMENT FILE (1)].')
        MULTI = -1
 
      ELSE
        IF(CMTPTH(1) .NE. 40)
     +    CALL ERROR('[ISTLX - INVALID COMMENT FILE (2)].')
 
        CALL SCOPY(TKNPTH, 2, TEMP, 1)
        POINTT = LENGTH(TEMP)
        IF(TEMP(POINTT) .NE. 41)
     +    CALL ERROR('[ISTLX - INVALID TOKEN FILE (1)].')
        TEMP(POINTT) = 129
        CALL SCOPY(TEMP, 1, TKNPTH, 1)
 
        CALL SCOPY(CMTPTH, 2, TEMP, 1)
        POINTC = LENGTH(TEMP)
        IF(TEMP(POINTC) .NE. 41)
     +    CALL ERROR('[ISTLX - INVALID COMMENT FILE (3)].')
        TEMP(POINTC) = 129
        CALL SCOPY(TEMP, 1, CMTPTH, 1)
 
        IF(TKNPTH(1) .EQ. 35) THEN
          IF(POINTT .LE. 5)
     +       CALL ERROR('[ISTLX - INVALID TOKEN FILE (4)].')
          TPT1 = HOST1+1
          TPT2 = HOST2+1
          TPT3 = HOST3+1
        ELSE
          DO 10 I = LENGTH(TKNPTH), 1, -1
           IF(TKNPTH(I) .EQ. 47) GO TO 15
   10     CONTINUE
          I = 1
   15     CONTINUE
          IF(POINTT-I .LT. 4)
     +    CALL ERROR('[ISTLX - INVALID TOKEN FILE (5)].')
          TPT1 = I + 1
          TPT2 = I + 2
          TPT3 = I + 3
        ENDIF
        IF(LENGTH(TKNPTH) .LT. TPT3)
     +    CALL ERROR('[ISTLX - INVALID TOKEN FILE (2)].')
 
        IF(CMTPTH(1) .EQ. 35) THEN
          IF(POINTC .LE. 5)
     +       CALL ERROR('[ISTLX - INVALID COMMENT FILE (4)].')
          CPT1 = HOST1+1
          CPT2 = HOST2+1
          CPT3 = HOST3+1
        ELSE
          DO 20 I = LENGTH(CMTPTH), 1, -1
            IF(CMTPTH(I) .EQ. 47) GO TO 25
   20     CONTINUE
          I = 1
   25     CONTINUE
          IF(POINTC-I .LT. 4)
     +    CALL ERROR('[ISTLX - INVALID COMMENT FILE (5)].')
          CPT1 = I + 1
          CPT2 = I + 2
          CPT3 = I + 3
        ENDIF
        IF(LENGTH(CMTPTH) .LT. CPT3)
     +    CALL ERROR('[ISTLX - INVALID COMMENT FILE (4)].')
 
        TKNPTH(TPT1) = 65
        TKNPTH(TPT2) = 65
        TKNPTH(TPT3) = 65
        CMTPTH(CPT1) = 65
        CMTPTH(CPT2) = 65
        CMTPTH(CPT3) = 65
        MULTI = 0
      ENDIF
 
      END
C-------------------------------------------------
C
C  FORTRAN 77 SCANNER MAIN CONTROL SUBROUTINE
C
C  Repeatedly call the scanning utility and writing out
C  the tokens until the end of the file. This routine is
C  also responsible for creating the token stream files and
C  putting the head/tail on the listing file.
C
      SUBROUTINE NEWLX (SRC, LST, TKN, CMT, STATUS, MULTI)
 
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.5
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
      COMMON /NAMES/  TKNPTH, CMTPTH, TPT1, TPT2, TPT3, CPT1, CPT2, CPT3
      INTEGER         TKNPTH(81), CMTPTH(81), TPT1,
     +                TPT2, CPT1, CPT2, TPT3, CPT3
 
      INTEGER         SRC,LST,TKN,CMT,ERR, JUNK, I, STATUS, TKNTYP,
     +                MULTI, ITKNCH, TKNCHR(1322), DESC, DESC2,
     +                ZTKGTI, ZTKPTI
      LOGICAL         FIRST, WASEND
      INTEGER         STAT
      INTEGER         CREATE
 
      SAVE /NAMES/
C
      IF(LST .NE. -1) THEN
        CALL ZMESS('    TOOLPACK FORTRAN 77 SCANNER - RELEASE 2.', LST)
        CALL PUTCH(10, LST)
        IF(MULTI .GE. 0) THEN
          CALL ZCHOUT('----   TOKEN FILE: .', LST)
          CALL ZPTMES(TKNPTH, LST)
          CALL ZCHOUT('     COMMENT FILE: .', LST)
          CALL ZPTMES(CMTPTH, LST)
        ENDIF
      ENDIF
C
C  LOOP AROUND CALLING THE SCANNER FOR EACH TOKEN AND THEN PUTTING THE
C  TOKEN IN THE TOKEN STREAM FILE, NOTE THAT COMMENTS ARE STORED AWAY
C  BY GETBUF AS PART OF THE SCANNING PROCESS.
C
      DESC  = ZTKGTI(0, SRC, LST)
      DESC2 = ZTKPTI(1, TKN, CMT)
 
   10 CONTINUE
        CALL ZSCAN(TKNTYP, ITKNCH, TKNCHR, DESC, STATUS)
        IF(STATUS .EQ. -1) RETURN
        CALL ZPUTTK(TKNTYP, ITKNCH, TKNCHR, DESC2)
 
        IF(TKNTYP .NE. TZEOF) THEN
          FIRST = .FALSE.
          IF(MULTI .LT. 0) GO TO 10
          IF(TKNTYP .EQ. TEND) THEN
            WASEND = .TRUE.
            GO TO 10
          ELSE IF(TKNTYP .EQ. TZEOS) THEN
            IF(.NOT. WASEND) GO TO 10
          ELSE
            WASEND = .FALSE.
            GO TO 10
          ENDIF
 
          WASEND = .FALSE.
          FIRST = .TRUE.
          MULTI = MULTI + 1
          IF((TKNPTH(TPT3) .EQ. 90) .OR. (TKNPTH(TPT3) .EQ. 122)) THEN
            TKNPTH(TPT3) = 65
            CMTPTH(CPT3) = 65
            IF((TKNPTH(TPT2) .EQ. 90) .OR. (TKNPTH(TPT2) .EQ. 122)) THEN
              TKNPTH(TPT2) = 65
              CMTPTH(CPT2) = 65
              TKNPTH(TPT1) = TKNPTH(TPT1) + 1
              CMTPTH(CPT1) = CMTPTH(CPT1) + 1
            ELSE
              TKNPTH(TPT2) = TKNPTH(TPT2) + 1
              CMTPTH(CPT2) = CMTPTH(CPT2) + 1
            ENDIF
          ELSE
            TKNPTH(TPT3) = TKNPTH(TPT3) + 1
            CMTPTH(CPT3) = CMTPTH(CPT3) + 1
          ENDIF
          CALL ZPUTTK(TZEOF, 0, TKNCHR, DESC2)
          CALL CLOSE(TKN)
          CALL CLOSE(CMT)
          TKN = CREATE(TKNPTH, 1)
          CMT = CREATE(CMTPTH, 1)
          IF(TKN .EQ. -1)
     +      CALL ERROR('ISTLX - UNABLE TO CREATE TOKEN FILE (2).')
          IF(CMT .EQ. -1)
     +      CALL ERROR('ISTLX - UNABLE TO CREATE COMMENT FILE (2).')
          IF(LST .NE. -1) THEN
            CALL ZCHOUT('----   TOKEN FILE: .', LST)
            CALL ZPTMES(TKNPTH, LST)
            CALL ZCHOUT('     COMMENT FILE: .', LST)
            CALL ZPTMES(CMTPTH, LST)
          ENDIF
          GO TO 10
        ENDIF
 
      CALL CLOSE(TKN)
      CALL CLOSE(CMT)
      IF((MULTI .GT. 0) .AND. FIRST) THEN
        CALL ZCHOUT('REMOVING TOKEN FILE: .', LST)
        CALL ZPTMES(TKNPTH, LST)
        CALL ZCHOUT('REMOVING COMMENT FILE: .', LST)
        CALL ZPTMES(CMTPTH, LST)
        CALL REMOVE(TKNPTH)
        CALL REMOVE(CMTPTH)
      ENDIF
      IF(LST .NE. -1)CALL PUTCH(10, LST)
 
      END
